Attribute VB_Name = "modMain"
'---------------------------------------------------------------------------------------
'Module : modMain
'Date   : 03/17/2004
'Author : Chris Elwell
'Purpose: 1. Declare project global variables (Non FXRS)
'         2. Formatting routines (numeric, field length, acct# check, etc.)
'         3. Routines for loading combo boxes
'         4. Scale routine
'2005-08-31, JFW, Manitoba is MB.
'---------------------------------------------------------------------------------------
'
Option Explicit

Public g_blnComplete As Boolean                     'Set to true after each transaction
Public g_blnBatch As Boolean                        'Set to True when processing batch
Public g_blnMPS As Boolean                          'Set to True after MPS Completes processing
Public g_blnPreAssign As Boolean                    'Set to True on pre-assign transactions
Public g_blnLockOrderID As Boolean                  'If True disables order lookup on f1_LostFocus event. Set to False in ClearScreen
Public g_blnFormLoadComplete As Boolean             'Used to speed up execution of program
Public g_blnAbortBatch As Boolean                   'Used to Abort batch processing
Public g_blnRate As Boolean                         'Used to indicate a Rate trans from the Ship screen
Public g_blnDeletesComplete As Boolean              'Used to control program flow when deleting multiple pkgs using grdShipments
Public g_blnAllowOptimize As Boolean                'Makes txtDelDate field and calendar4 visible for optimization
Public g_blnDoOptimize As Boolean                   'Set to true to select the service automatically
Public g_blnNextClose As Boolean                    'Used to control the flow of FXRS Closes when "ALL" selected
Public g_blnBatchErrorCheck As Boolean              'Used when using Batch Error Check
Public g_blnCODFirstPiece As Boolean                'Used for MPS COD on First Piece
Public g_blnCODNextPiece As Boolean                 'Used for MPS COD on First Piece
Public g_blnBatchEdit As Boolean                    'Set to True when processing batch error edit
Public g_blnLookup As Boolean                       'Set to True once an address lookup is performed, False in ClearShipFields
Public g_blnIPD As Boolean                          'Set to True when IPD is selected
Public g_blnUseLabelFldsInBatch As Boolean          'Set to True to use Label setup in Batch processing
Public g_blnIPDConfirm As Boolean                   'Set to True when confirming an IPD shipment

Public g_intErrorCount As Integer                   'Number of errors
Public g_intShipCount As Integer                    'Number of Shipments
Public g_strReply As String                         'FXRS Reply string
Public g_strSaveReply As String                     'Saved FXRS Reply string
Public g_intDupCount As Integer                     'Used to count duplicate pkgs
Public g_strErrorLocation As String                 'Used to identify module in error handling
Public g_clsReg As clsRegistryRoutines              'Registry class object
Public g_clsSettings As clsXMLSettings              'Saved settings in folder with 'exe', so may be global or local
Public Const MAINKEYROOT = "Software\FXRSClient"    'Registry class constant
Public Const MAINSUBKEY = "Settings"                'Registry class constant
Public g_rsCommodities As ADODB.Recordset           'Commodity Recordset
Public g_connFSMSClient As ADODB.Connection         'Connection to FSMSClient.mdb
Public g_connFXRS As ADODB.Connection               'Connection to FXRS
Public g_strMappedPath As String                    'Used to save Mapped Path to global var
Public g_strUNCCustomLabels As String               'Used in creating custom labels
Public g_strCUST(9) As String                       'Non FXRS custom label fields

'API routine to get Windows UserID
Public Declare Function GetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal lpBuffer As String, nSize As Long) As Long
'API function to get Computername
 Private Declare Function GetComputerName Lib "kernel32" Alias "GetComputerNameA" (ByVal sBuffer As String, lSize As Long) As Long
'API function used in SearchCombo function.
Public Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
    (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, ByVal lParam As Any) As Long
Public Const CB_FINDSTRING = &H14C


Public g_rsMPS As ADODB.Recordset

Public g_frmMsgBox As frmMsgBox

Public g_strTDOpenShip As String
Public g_blnTDChild As Boolean
'

'---------------------------------------------------------------------------------------
' Module    : ImpliedDecimal
' DateTime  : 2/13/2004
' Author    : Chris Elwell
' Purpose   : Checks for a decimal point in a numeric string and formats to the number of
'             decimal places passed(e.g. 2., 2, 2.0 all formatted to 2.00) The number
'             of decimal places defaults to 2 if not passed.
'             This should be used with fields that have implied decimal places in FXRS.
'             Use the RemoveSpecial function to remove the decimal point
'             when building the FXRS transaction string.
'---------------------------------------------------------------------------------------
'
Public Function ImpliedDecimal(ByVal strText As String, Optional ByVal intPlaces As Integer = 2) As String
    Dim intPosition As Integer
    Dim intLenAfterDecimal As Integer
    Dim i As Integer
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:ImpliedDecimal"
    
    'If string is empty return it empty
    If strText = "" Then
        ImpliedDecimal = ""
        Exit Function
    End If
    
    intPosition = InStr(1, strText, ".")
    intLenAfterDecimal = Len(Right(strText, Len(strText) - intPosition))
    If intPosition = 0 Then
        strText = strText & "."
        For i = 1 To intPlaces
            strText = strText & "0"
        Next
    ElseIf intLenAfterDecimal <> intPlaces Then
        strText = Left(strText, intPosition + intLenAfterDecimal)
        For i = 1 To intPlaces - intLenAfterDecimal
            strText = strText & "0"
        Next
    End If
    
    ImpliedDecimal = strText
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, g_strErrorLocation

End Function
'---------------------------------------------------------------------------------------
' Module    : FormatCharges
' DateTime  : 03/15/2004
' Author    : Chris Elwell
' Purpose   : Formats an FXRS charges reply field string (e.g. fields 34 -37)
'             or surcharges field (e.g. 421 - 430) with 2 decimal places
'---------------------------------------------------------------------------------------
'
Public Function FormatCharges(ByVal strValue As String) As String
    On Error GoTo EH
    g_strErrorLocation = "modMain:FormatCharges"
        
    'If not a number of length < 2 return the orginal string
    If Len(strValue) < 2 Or Not IsNumeric(strValue) Then
        FormatCharges = strValue
    Else
        FormatCharges = Left(Trim(strValue), Len(strValue) - 2) & "." & Right(Trim(strValue), 2)
    End If
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, g_strErrorLocation

End Function
'---------------------------------------------------------------------------------------
' Module    : NumericOnly
' DateTime  : 2/13/2004
' Author    : Chris Elwell
' Purpose   : Allows only numbers and decimal point in the texMyControl passed. Places the
'             cursor at the end of the field after modifying. Use with fields that should
'             only have numeric values.
'---------------------------------------------------------------------------------------
'
Public Function NumericOnly(ByRef MyControl As Control, Optional ByVal blnAllowDecimal As Boolean = True)
    Dim i As Integer
    Dim strNumber As String
    
    On Error GoTo EH
    ' g_strErrorLocation = "modMain:NumericOnly"
    
    For i = 1 To Len(MyControl)
        If IsNumeric(Mid(MyControl, i, 1)) Or IIf(blnAllowDecimal, Mid(MyControl, i, 1) = ".", False) Then
            strNumber = strNumber & Mid(MyControl, i, 1)
        End If
    Next
    MyControl = strNumber
    MyControl.SelStart = Len(MyControl)

    Exit Function
EH:
    ' MsgBox "NumericOnly crash, " & MyControl.name & ", " & MyControl
     
     MsgBox Err.Description, vbCritical, "modMain:NumericOnly"

End Function
'---------------------------------------------------------------------------------------
' Module    : RemoveSpecial
' DateTime  : 6/2/2004
' Author    : Chris Elwell
' Purpose   : Removes special characters. Allows only alpha-numeric characters.
'---------------------------------------------------------------------------------------
'
Public Function RemoveSpecial(ByRef strSearch As String) As String

     Dim intStrSize As Integer      'Length of the incoming phone string
     Dim i As Integer               'For loop counter
     Dim strDigit As String         'Holds the character being evaluated
     Dim strText As String          'Holds the text to be returned
     
    On Error GoTo EH
    g_strErrorLocation = "modMain:RemoveSpecial"
     
     'Get length of String passed in
     intStrSize = Len(Trim(strSearch))
     
     'Go through the string one character at a time and if it's numeric add it to strText
     For i = 1 To intStrSize
     strDigit = Mid(Trim(strSearch), i, 1)
         'If The Character Is Numeric Add it to strText
         If IsNumeric(strDigit) Or (Asc(strDigit) >= 65 And Asc(strDigit) <= 90) _
            Or (Asc(strDigit) >= 97 And Asc(strDigit) <= 112) Then
            strText = strText & strDigit
         End If
     Next
     'Return the phone number
     RemoveSpecial = strText
     
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Function
'---------------------------------------------------------------------------------------
' Module        : ReadScale
' DateTime      : 5/11/04
' Modified      : 7/16/04
' Author        : Chris Elwell
' Purpose       : Function to read a Toldeo scale. Removed rounding code since field 1670
'                 has 2 implied decimal places.
' Requirements  : Pass port (e.g. "1", "2", etc.) as string.
'---------------------------------------------------------------------------------------
'
Public Function ReadScale(ByVal strPort As String) As String
    Dim ScaleWeight As String
    Dim PauseTime As Single
    Dim Start As Single

    On Error GoTo EH
    g_strErrorLocation = "modMain:ReadScale"
    
    With frmShip.MSComm1
        .CommPort = CInt(strPort)
        .Settings = "9600,E,7,1"
        .InputLen = 0
        .PortOpen = True
        .Output = "W"
        PauseTime = 5   ' Set timeout duration.
        Start = Timer   ' Set start time.
        'Try to read. Timeout set above
        Do
            If Timer > PauseTime + Start Then
                ScaleWeight = Chr(2) & "?Timeout" & Chr(13)
            Else
                ScaleWeight = ScaleWeight & .Input
            End If
        Loop Until InStr(1, ScaleWeight, Chr(13)) > 0
        ScaleWeight = Left(ScaleWeight, Len(ScaleWeight) - 1)
        ScaleWeight = Right(ScaleWeight, Len(ScaleWeight) - 1)
        .PortOpen = False
    End With
        
    'Display scale error
    If Left(ScaleWeight, 1) = "?" Then
        Select Case ScaleWeight
            Case "?d"
                MsgBox "Scale weight less than 0", vbExclamation, "Scale Read Error"
            Case "?Timeout"
                MsgBox "Scale read timeout", vbExclamation, "Scale Read Error"
            Case "?i"
                MsgBox "Scale is in motion", vbExclamation, "Scale Read Error"
            Case "?k" Or "?j"
                MsgBox "Scale maximum weight exceeded", vbExclamation, "Scale Read Error"
            Case Else
                MsgBox "Scale error", vbExclamation, "Scale Read Error"
        End Select
    Else
        ReadScale = ScaleWeight
    End If
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Function
'---------------------------------------------------------------------------------------
' Module    : AccountNumCheckOK
' DateTime  : 2/18/2004
' Author    : Chris Elwell
' Purpose   : Pass an Account# string it returns true if a valid FedEx account format.
'---------------------------------------------------------------------------------------
'
Public Function AcctNumCheckOK(ByVal strAcctNum As String) As Boolean
    Dim intAcctNumArray(8) As Integer
    Dim intTotal As Integer
    Dim intQuotient As Integer
    Dim intRemainder As Integer
    Dim intCheckDigit As Integer
    Dim i As Integer
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:AcctNumCheckOK"
    
    'If not correct length return false and exit
    If Len(strAcctNum) <> 9 Then
        AcctNumCheckOK = False
        Exit Function
    End If
    
    intAcctNumArray(1) = Val(Mid(strAcctNum, 1, 1)) * 3
    intAcctNumArray(2) = Val(Mid(strAcctNum, 2, 1)) * 2
    intAcctNumArray(3) = Val(Mid(strAcctNum, 3, 1)) * 7
    intAcctNumArray(4) = Val(Mid(strAcctNum, 4, 1)) * 6
    intAcctNumArray(5) = Val(Mid(strAcctNum, 5, 1)) * 5
    intAcctNumArray(6) = Val(Mid(strAcctNum, 6, 1)) * 4
    intAcctNumArray(7) = Val(Mid(strAcctNum, 7, 1)) * 3
    intAcctNumArray(8) = Val(Mid(strAcctNum, 8, 1)) * 2
    'Total products of each digit
    For i = 1 To 8
        intTotal = intTotal + intAcctNumArray(i)
    Next i
    'Divide and get intRemainder
    intQuotient = Int(intTotal / 11)
    intRemainder = Int(intTotal - (intQuotient * 11))
    'If intRemainder is 1 or 0 check digit = 0, else subtract from 11
    If intRemainder < 2 Then
        intCheckDigit = 0
    Else
        intCheckDigit = 11 - intRemainder
    End If
    'Check to see if actual equals calculated check digit
    If Val(Right(strAcctNum, 1)) = intCheckDigit Then
        AcctNumCheckOK = True
    Else
        AcctNumCheckOK = False
    End If
    
    Exit Function
EH:
     MsgBox Err.Description, vbCritical, g_strErrorLocation

End Function
'---------------------------------------------------------------------------------------
' Module    : CheckLength
' DateTime  : 2/18/2004
' Author    : Chris Elwell
' Purpose   : Pass a Text box and desired length and this limits length to value passed.
'---------------------------------------------------------------------------------------
'
Public Function CheckLength(ByVal TBox As TextBox, ByVal intLength As Integer)
    If Len(TBox) > intLength Then
        TBox = Left(TBox, intLength)
    End If
End Function
'---------------------------------------------------------------------------------------
' Module    : SingleQuotes
' DateTime  : 3/8/2004
' Author    : Chris Elwell
' Purpose   : Add single quotes to a string and replaces ' with '' for SQL text fields.
'---------------------------------------------------------------------------------------
'
Public Function SingleQuotes(ByVal strText As String) As String
    SingleQuotes = "'" & Replace(strText, "'", "''") & "'"
End Function
'---------------------------------------------------------------------------------------
' Module    : LoadStates
' DateTime  : 3/16/2004
' Modified  : 7/12/2004 - Added PR
' Author    : Chris Elwell
' Purpose   : Load states into a combo box.
' Call from : Form_Load in frmBSO, frmCOD, frmHAL, frmShip, & frmSetup, and in frmBSO.f1186_Change()
'---------------------------------------------------------------------------------------
'
Public Sub LoadStates(CBox As ComboBox, Optional strCurrent As String)
    
    Dim i As Integer
    
    CBox.Clear
    
    CBox.AddItem "AK - Alaska"
    CBox.AddItem "AL - Alabama"
    CBox.AddItem "AR - Arkansas"
    CBox.AddItem "AZ - Arizona"
    CBox.AddItem "CA - California"
    CBox.AddItem "CO - Colorado"
    CBox.AddItem "CT - Connecticut"
    CBox.AddItem "DC - District of Columbia"
    CBox.AddItem "DE - Delaware"
    CBox.AddItem "FL - Florida"
    CBox.AddItem "GA - Georgia"
    CBox.AddItem "HI - Hawaii"
    CBox.AddItem "IA - Iowa"
    CBox.AddItem "ID - Idaho"
    CBox.AddItem "IL - Illinois"
    CBox.AddItem "IN - Indiana"
    CBox.AddItem "KS - Kansas"
    CBox.AddItem "KY - Kentucky"
    CBox.AddItem "LA - Louisiana"
    CBox.AddItem "MA - Massachusetts"
    CBox.AddItem "MD - Maryland"
    CBox.AddItem "ME - Maine"
    CBox.AddItem "MI - Michigan"
    CBox.AddItem "MN - Minnesota"
    CBox.AddItem "MO - Missouri"
    CBox.AddItem "MS - Mississippi"
    CBox.AddItem "MT - Montana"
    CBox.AddItem "NC - North Carolina"
    CBox.AddItem "ND - North Dakota"
    CBox.AddItem "NE - Nebraska"
    CBox.AddItem "NH - New Hampshire"
    CBox.AddItem "NJ - New Jersey"
    CBox.AddItem "NM - New Mexico"
    CBox.AddItem "NV - Nevada"
    CBox.AddItem "NY - New York"
    CBox.AddItem "OH - Ohio"
    CBox.AddItem "OK - Oklahoma"
    CBox.AddItem "OR - Oregon"
    CBox.AddItem "PA - Pennsylvania"
    CBox.AddItem "RI - Rhode Island"
    CBox.AddItem "SC - South Carolina"
    CBox.AddItem "SD - South Dakota"
    CBox.AddItem "TN - Tennesee"
    CBox.AddItem "TX - Texas"
    CBox.AddItem "UT - Utah"
    CBox.AddItem "VA - Virginia"
    CBox.AddItem "VT - Vermont"
    CBox.AddItem "WA - Washington"
    CBox.AddItem "WI - Wisconsin"
    CBox.AddItem "WV - West Virginia"
    CBox.AddItem "WY - Wyoming"
    CBox.AddItem "PR - Puerto Rico"
    
    For i = 0 To CBox.ListCount - 1
        If Left(CBox.List(i), 2) = Left(strCurrent, 2) Then
            CBox = strCurrent
            Exit For
        End If
    Next


End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadProvinces
' DateTime  : 9/15/2004
' Author    : Chris Elwell
' Purpose   : Load Canadian Provonces into a combo box.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadProvinces(CBox As ComboBox, Optional strCurrent As String)
    
    Dim i As Integer
    
    CBox.Clear
    
    CBox.AddItem "AB - Alberta"
    CBox.AddItem "BC - British Columbia"
    CBox.AddItem "MB - Manitoba"
    CBox.AddItem "NB - New Brunswick"
    CBox.AddItem "NF - Newfoundland"
    CBox.AddItem "NT - Northwest Territories"
    CBox.AddItem "NS - Nova Scotia"
    CBox.AddItem "ON - Ontario"
    CBox.AddItem "PE - Prince Edward Island"
    CBox.AddItem "QC - Quebec"
    CBox.AddItem "SK - Saskatchewan"
    CBox.AddItem "YT - Yukon"
    
    For i = 0 To CBox.ListCount - 1
        If Left(CBox.List(i), 2) = Left(strCurrent, 2) Then
            CBox = strCurrent
            Exit For
        End If
    Next

End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadCountries
' DateTime  : 3/16/2004
' Author    : Chris Elwell
' Purpose   : Load countries into a combo box.
' Call from : Form_Load in frmBSO, frmCOD, frmHAL, frmShip(4 times)
'---------------------------------------------------------------------------------------
'
Public Sub LoadCountries(CBox As ComboBox)

    CBox.AddItem "AD - ANDORRA"
    CBox.AddItem "AE - UNITED ARAB EMIRATES"
    CBox.AddItem "AF - AFGHANISTAN"
    CBox.AddItem "AG - ANTIGUA"
    CBox.AddItem "AI - ANGUILLA"
    CBox.AddItem "AL - ALBANIA"
    CBox.AddItem "AM - ARMENIA"
    CBox.AddItem "AN - NETHERLANDS ANTILLES"
    CBox.AddItem "AO - ANGOLA"
    CBox.AddItem "AR - ARGENTINA"
    CBox.AddItem "AS - AMERICAN SAMOA"
    CBox.AddItem "AT - AUSTRIA"
    CBox.AddItem "AU - AUSTRALIA"
    CBox.AddItem "AW - ARUBA"
    CBox.AddItem "AZ - AZERBAIJAN"
    CBox.AddItem "BA - BOSNIA, HERZEGOVINA"
    CBox.AddItem "BB - BARBADOS"
    CBox.AddItem "BD - BANGLADESH"
    CBox.AddItem "BE - BELGIUM"
    CBox.AddItem "BF - BURKINA FASO"
    CBox.AddItem "BG - BULGARIA"
    CBox.AddItem "BH - BAHRAIN"
    CBox.AddItem "BI - BURUNDI"
    CBox.AddItem "BJ - BENIN"
    CBox.AddItem "BM - BERMUDA"
    CBox.AddItem "BN - BRUNEI"
    CBox.AddItem "BO - BOLIVIA"
    CBox.AddItem "BR - BRAZIL"
    CBox.AddItem "BS - BAHAMAS"
    CBox.AddItem "BT - BHUTAN"
    CBox.AddItem "BV - BOUVET ISLAND"
    CBox.AddItem "BW - BOTSWANA"
    CBox.AddItem "BY - BELARUS"
    CBox.AddItem "BZ - BELIZE"
    CBox.AddItem "CA - CANADA"
    
    CBox.AddItem "CC - COCOS (KEELING) ISLANDS"

    CBox.AddItem "CD - CONGO, DEM. REP. OF"
    CBox.AddItem "CF - CENTRAL AFRICAN REPUBLIC"
    CBox.AddItem "CG - CONGO"
    CBox.AddItem "CH - SWITZERLAND"
    CBox.AddItem "CI - IVORY COAST"
    CBox.AddItem "CK - COOK ISLANDS"
    CBox.AddItem "CL - CHILE"
    CBox.AddItem "CM - CAMEROON"
    CBox.AddItem "CN - CHINA"
    CBox.AddItem "CO - COLOMBIA"
    CBox.AddItem "CR - COSTA RICA"
    
    CBox.AddItem "CS - SERBIA And MONTENEGRO"
    
    CBox.AddItem "CU - CUBA"


    CBox.AddItem "CV - CAPE VERDE"
    
    CBox.AddItem "CX - CHRISTMAS ISLAND"
    
    CBox.AddItem "CY - CYPRUS"
    CBox.AddItem "CZ - CZECH REPUBLIC"
    CBox.AddItem "DE - GERMANY"
    CBox.AddItem "DJ - DJIBOUTI"
    CBox.AddItem "DK - DENMARK"
    CBox.AddItem "DM - DOMINICA"
    CBox.AddItem "DO - DOMINICAN REPUBLIC"
    
    CBox.AddItem "DZ - ALGERIA"
    
    CBox.AddItem "EC - ECUADOR"
    CBox.AddItem "EE - ESTONIA"
    CBox.AddItem "EG - EGYPT"
    
    CBox.AddItem "EH - WESTERN SAHARA"
    
    CBox.AddItem "ER - ERITREA"
    CBox.AddItem "ES - SPAIN"
    CBox.AddItem "ET - ETHIOPIA"
    CBox.AddItem "FI - FINLAND"
    CBox.AddItem "FJ - FIJI"
    
    CBox.AddItem "FK - FALKLAND ISLANDS"


    CBox.AddItem "FM - MICRONESIA"
    CBox.AddItem "FO - FAROE ISLAND"
    CBox.AddItem "FR - FRANCE"
    CBox.AddItem "GA - GABON"
    CBox.AddItem "GB - GREAT BRITAIN"
    CBox.AddItem "GD - GRENADA"
    CBox.AddItem "GE - GEORGIA"
    CBox.AddItem "GF - FRENCH GUIANA"
    CBox.AddItem "GH - GHANA"
    CBox.AddItem "GI - GIBRALTAR"
    CBox.AddItem "GL - GREENLAND"
    CBox.AddItem "GM - GAMBIA"
    CBox.AddItem "GN - GUINEA"
    CBox.AddItem "GP - GUADELOUPE"
    CBox.AddItem "GQ - EQUATORIAL GUINEA"
    CBox.AddItem "GR - GREECE"
    
    CBox.AddItem "GS - SOUTH GEORGIA & SO SANDWICH IS"


    CBox.AddItem "GT - GUATEMALA"
    CBox.AddItem "GU - GUAM"
    CBox.AddItem "GY - GUYANA"
    
    CBox.AddItem "GW - GUINEA BISSAU"


    CBox.AddItem "HK - HONG KONG"
    CBox.AddItem "HN - HONDURAS"
    CBox.AddItem "HR - CROATIA"
    CBox.AddItem "HT - HAITI"
    CBox.AddItem "HU - HUNGARY"
    CBox.AddItem "ID - INDONESIA"
    CBox.AddItem "IE - IRELAND"
    CBox.AddItem "IL - ISRAEL"
    CBox.AddItem "IN - INDIA"
    CBox.AddItem "IQ - IRAQ"
    CBox.AddItem "IS - ICELAND"
    CBox.AddItem "IT - ITALY"
    CBox.AddItem "JM - JAMAICA"
    CBox.AddItem "JO - JORDAN"
    CBox.AddItem "JP - JAPAN"
    CBox.AddItem "KE - KENYA"
    CBox.AddItem "KG - KYRGYZSTAN"
    CBox.AddItem "KH - CAMBODIA"
    CBox.AddItem "KN - ST KITTS AND NEVIS"
    
    CBox.AddItem "KI - KIRIBATI"
    CBox.AddItem "KM - COMOROS"
    CBox.AddItem "KN - ST.CHRISTOPHER"
    CBox.AddItem "KN - ST.KITTS And NEVIS"
    CBox.AddItem "KP - NORTH KOREA"

    CBox.AddItem "KR - SOUTH KOREA"
    CBox.AddItem "KW - KUWAIT"
    CBox.AddItem "KY - CAYMAN ISLANDS"
    CBox.AddItem "KZ - KAZAKHSTAN"
    CBox.AddItem "LA - LAOS"
    CBox.AddItem "LB - LEBANON"
    CBox.AddItem "LC - ST LUCIA"
    CBox.AddItem "LI - LIECHTENSTEIN"
    CBox.AddItem "LK - SRI LANKA"
    CBox.AddItem "LR - LIBERIA"
    CBox.AddItem "LS - LESOTHO"
    CBox.AddItem "LT - LITHUANIA"
    CBox.AddItem "LU - LUXEMBOURG"
    CBox.AddItem "LV - LATVIA"
    
    CBox.AddItem "LY - LIBYA"
    
    CBox.AddItem "MA - MOROCCO"
    CBox.AddItem "MC - MONACO"
    CBox.AddItem "MD - MOLDOVA"
    
    CBox.AddItem "ME  MONTENEGRO"
    
    CBox.AddItem "MG - MADAGASCAR"
    CBox.AddItem "MH - MARSHALL ISLANDS"
    CBox.AddItem "MK - MACEDONIA"
    CBox.AddItem "ML - MALI"
    
    CBox.AddItem "MM - MYANMAR / BURMA"
    
    CBox.AddItem "MN - MONGOLIA"
    CBox.AddItem "MO - MACAU"
    CBox.AddItem "MP - SAIPAN"
    CBox.AddItem "MQ - MARTINIQUE"
    CBox.AddItem "MR - MAURITANIA"
    CBox.AddItem "MS - MONTSERRAT"
    CBox.AddItem "MT - MALTA"
    CBox.AddItem "MU - MAURITIUS"
    CBox.AddItem "MV - MALDIVES"
    CBox.AddItem "MW - MALAWI"
    CBox.AddItem "MX - MEXICO"
    CBox.AddItem "MY - MALAYSIA"
    CBox.AddItem "MZ - MOZAMBIQUE"
    CBox.AddItem "NA - NAMIBIA"
    CBox.AddItem "NC - NEW CALEDONIA"
    CBox.AddItem "NE - NIGER"
    CBox.AddItem "NG - NIGERIA"
    CBox.AddItem "NI - NICARAGUA"
    CBox.AddItem "NL - NETHERLANDS"
    CBox.AddItem "NO - NORWAY"
    CBox.AddItem "NP - NEPAL"
    CBox.AddItem "NZ - NEW ZEALAND"
    CBox.AddItem "OM - OMAN"
    CBox.AddItem "PA - PANAMA"
    CBox.AddItem "PE - PERU"
    CBox.AddItem "PF - FRENCH POLYNESIA"
    CBox.AddItem "PG - PAPUA NEW GUINEA"
    CBox.AddItem "PH - PHILIPPINES"
    CBox.AddItem "PK - PAKISTAN"
    CBox.AddItem "PL - POLAND"
    CBox.AddItem "PR - PUERTO RICO"
    CBox.AddItem "PS - PALESTINE AUTONOMOUS"
    CBox.AddItem "PT - PORTUGAL"
    CBox.AddItem "PW - PALAU"
    CBox.AddItem "PY - PARAGUAY"
    CBox.AddItem "QA - QATAR"
    
    CBox.AddItem "PM - ST.PIERRE"
    CBox.AddItem "PN - PITCAIRN"
    
    CBox.AddItem "RE - REUNION ISLAND"
    CBox.AddItem "RO - ROMANIA"
    
    CBox.AddItem "RS - SERBIA"
    
    CBox.AddItem "RU - RUSSIA"
    CBox.AddItem "RW - RWANDA"
    CBox.AddItem "SA - SAUDI ARABIA"
    CBox.AddItem "SC - SEYCHELLES"
    
    CBox.AddItem "SD - SUDAN"
    
    CBox.AddItem "SE - SWEDEN"
    CBox.AddItem "SG - SINGAPORE"
    CBox.AddItem "SI - SLOVENIA"
    CBox.AddItem "SK - SLOVAK REPUBLIC"
    CBox.AddItem "SN - SENEGAL"
    CBox.AddItem "SR - SURINAME"
    CBox.AddItem "SV - EL SALVADOR"
    CBox.AddItem "SY - SYRIA"
    CBox.AddItem "SZ - SWAZILAND"
    CBox.AddItem "TC - TURKS & CAICOS ISLANDS"
    CBox.AddItem "TD - CHAD"
    CBox.AddItem "TG - TOGO"
    CBox.AddItem "TH - THAILAND"
    
    CBox.AddItem "TJ - TAJIKISTAN"
    CBox.AddItem "TK - TOKELAU"
    CBox.AddItem "TL - EAST TIMOR"


    CBox.AddItem "TM - TURKMENISTAN"
    CBox.AddItem "TN - TUNISIA"
    
    CBox.AddItem "TO - TONGA"
    
    
    CBox.AddItem "TR - TURKEY"
    CBox.AddItem "TT - TRINIDAD & TOBAGO"
    CBox.AddItem "TW - TAIWAN"
    CBox.AddItem "TZ - TANZANIA"
    CBox.AddItem "UA - UKRAINE"
    CBox.AddItem "UG - UGANDA"
    CBox.AddItem "US - UNITED STATES"
    CBox.AddItem "UY - URUGUAY"
    CBox.AddItem "UZ - UZBEKISTAN"
    CBox.AddItem "VA - VATICAN CITY"
    CBox.AddItem "VC - ST VINCENT"
    CBox.AddItem "VE - VENEZUELA"
    CBox.AddItem "VG - BRITISH VIRGIN ISLANDS"
    CBox.AddItem "VI - US VIRGIN ISLANDS"
    CBox.AddItem "VN - VIETNAM"
    CBox.AddItem "VU - VANUATU"
    CBox.AddItem "WF - WALLIS & FUTUNA"
    CBox.AddItem "YE - YEMEN ARAB REPUBLIC"
    CBox.AddItem "YU - YUGOSLAVIA"
    CBox.AddItem "ZA - SOUTH AFRICA"
    CBox.AddItem "ZM - ZAMBIA"
    CBox.AddItem "ZW - ZIMBABWE"
End Sub
'---------------------------------------------------------------------------------------
' Module    : LoadCurrencies
' DateTime  : 3/16/2004
' Author    : Chris Elwell
' Purpose   : Load currency types into a combo box.
' Call from : DomIntlScreenLayout, Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadCurrencies(CBox As ComboBox)
        
        CBox.AddItem "USD"
        CBox.AddItem "AUD"
        CBox.AddItem "AUS"
        CBox.AddItem "BHD"
        CBox.AddItem "BRC"
        CBox.AddItem "UKL"
        CBox.AddItem "CAD"
        CBox.AddItem "CHP"
        CBox.AddItem "ARA"
        CBox.AddItem "EUR"
        CBox.AddItem "HKD"
        CBox.AddItem "JYE"
        CBox.AddItem "LIT"
        CBox.AddItem "KUD"
        CBox.AddItem "MOP"
        CBox.AddItem "MYR"
        CBox.AddItem "NMP"
        CBox.AddItem "NTD"
        CBox.AddItem "NZD"
        CBox.AddItem "PHP"
        CBox.AddItem "ESC"
        CBox.AddItem "ARI"
        CBox.AddItem "SID"
        CBox.AddItem "SAR"
        CBox.AddItem "WON"
        CBox.AddItem "PTS"
        CBox.AddItem "THB"
        CBox.AddItem "TRL"
        CBox.AddItem "DHS"
        CBox.AddItem "UYP"
        CBox.AddItem "VEB"

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadMetersCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 2/18/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadMetersCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:LoadMetersCombo"
    
    strQuery = "SELECT f498 FROM Meters order by 1"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters("f498")
        
        rsMeters.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAddrIDCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 2/2/2005
' Purpose   : Loads the AddrID combo
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadAddrIDCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsAddrID As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:LoadAddrIDCombo"
    
    strQuery = "SELECT AddrID FROM AltReturnAddr"
    rsAddrID.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    Do While Not rsAddrID.EOF
        MyCombo.AddItem rsAddrID!AddrID
        
        rsAddrID.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsAddrID.State = adStateOpen Then rsAddrID.Close
    Set rsAddrID = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadAcctNumCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 6/10/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadAcctNumCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:LoadAcctNumCombo"
    
    strQuery = "SELECT f10 FROM Meters order by 1"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters!f10
        
        rsMeters.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadProfileCombo()
' DateTime  : 6/9/2004
' Purpose   : Loads the Profile names into Profile combo on Batch Default tab.
'---------------------------------------------------------------------------------------
'
Public Sub LoadProfileCombo(ByRef MyCombo As ComboBox, ByVal strSelected As String)

    Dim strQuery As String
    Dim rsProfile As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:LoadProfileCombo"
    
    strQuery = "SELECT ProfileName FROM BatchProfiles"
    rsProfile.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    If MyCombo.name <> "cboBatchProfile" Then
        MyCombo.AddItem "[Create New]"
    End If
    
    Do While Not rsProfile.EOF
        MyCombo.AddItem rsProfile!ProfileName
        rsProfile.MoveNext
    Loop
    
    MyCombo = strSelected
    
Release:
    If rsProfile.State = adStateOpen Then rsProfile.Close
    Set rsProfile = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub

'---------------------------------------------------------------------------------------
' Procedure : LoadNameCombo(ByRef MyCombo As ComboBox, ByRef strSelected As String)
' DateTime  : 6/10/2004
' Purpose   : Loads Meter # into Meter # combo. Pass the field name and
'             text of the selected meter.
' Call from : frmSetup.AddMeter(), frmSetup.GetSetupFromReg(), frmClose.Form_Load
'---------------------------------------------------------------------------------------
'
Public Sub LoadNameCombo(ByRef MyCombo As ComboBox, ByVal strSelected As String)

    Dim strQuery As String
    Dim rsMeters As New ADODB.Recordset
    
    On Error GoTo EH
    'g_strErrorLocation = "modMain:LoadNameCombo"
    
    strQuery = "SELECT Name FROM Meters order by 1"
    rsMeters.Open strQuery, g_connFSMSClient, adOpenStatic, adLockOptimistic
    
    MyCombo.Clear
    
    'Only add Create New to frmSetup.cboName
    If MyCombo.name = "cboName" Then
        MyCombo.AddItem "[Create New]"
    End If
    
    Do While Not rsMeters.EOF
        MyCombo.AddItem rsMeters("Name")
        
        rsMeters.MoveNext
    Loop
    
    MyCombo = strSelected

Release:
    If rsMeters.State = adStateOpen Then rsMeters.Close
    Set rsMeters = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, "modMain:LoadNameCombo"
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : LoadBoxDIMsCombos()
' DateTime  : 4/8/2004
' Purpose   : Load Box names in to DIM combos on frmShip, frmMPS
' Call from :
'---------------------------------------------------------------------------------------
'
Public Sub LoadBoxDIMsCombos(ByRef MyCombo As ComboBox, Optional ByVal strSelected As String)
    Dim rsBoxes As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:LoadBoxDIMsCombos"
    
    rsBoxes.Open "SELECT BoxName FROM Dimensions", g_connFSMSClient, adOpenStatic, adLockOptimistic
    If rsBoxes.EOF Then
        MyCombo.Visible = False
    Else
        MyCombo.Clear
        MyCombo.Visible = True
        Do Until rsBoxes.EOF
            MyCombo.AddItem rsBoxes!BoxName
            rsBoxes.MoveNext
        Loop
    End If

    MyCombo = strSelected
Release:
    If rsBoxes.State = adStateOpen Then rsBoxes.Close
    Set rsBoxes = Nothing
    
    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release

End Sub
'---------------------------------------------------------------------------------------
' Procedure : RoundUp
' DateTime  : 07/29/2003
' Written by: Keith Thomas
' Purpose   : Rounds weights up if not 0 after decimal, e.g. 1.1 rounded to 2.
' Call from :
'---------------------------------------------------------------------------------------
'
Public Function RoundUp(strWeight As String) As String
    
    Dim lngWeight As Long
    
    'On Local Error Goto EH
    g_strErrorLocation = "modMain:RoundUp"
    If strWeight = "" Then
        RoundUp = ""
        Exit Function
    End If
    
    lngWeight = CLng(strWeight)
    
    If lngWeight < CDbl(strWeight) Then
        lngWeight = lngWeight + 1
    End If
    
    RoundUp = Trim(Str(lngWeight))
    
    Exit Function

EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation

End Function
'---------------------------------------------------------------------------------------
' Module    : GetRateError
' DateTime  : 6/11/2004
' Author    : Chris Elwell
' Purpose   : Return Error Message for passed rating error code.
' Call from : frmShip.g_clsParser_ParseComplete, FSMSQuote.m_clsFXRS_ParseComplete
'---------------------------------------------------------------------------------------
'
Public Function GetRateError(ByVal strErrorCode As String) As String
    Dim strQuery As String
    Dim rsError As New ADODB.Recordset
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:GetRateError"
    
    strQuery = "SELECT ErrorMessage FROM RatingErrors WHERE ErrorCode = " & SingleQuotes(strErrorCode)
    rsError.Open strQuery, g_connFSMSClient, adOpenKeyset, adLockOptimistic
    
    If Not rsError.EOF Then
        GetRateError = rsError!ErrorMessage
    Else
        GetRateError = "Unknown Error - " & strErrorCode
    End If
    
Release:
    If rsError.State = adStateOpen Then rsError.Close
    Set rsError = Nothing
    
    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    Resume Release
    
End Function
'---------------------------------------------------------------------------------------
' Module    : SearchCombo
' DateTime  : 8/31/2004
' Author    : Chris Elwell
' Purpose   : Searches a combo for a string
'---------------------------------------------------------------------------------------
'
Public Function SearchCombo(ByRef MyCombo As ComboBox, ByRef intKey As Integer)
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:SearchCombo"
    
    Dim intIndex As Long
    Dim strTemp As String
    
    If MyCombo.SelStart = 0 Then
        strTemp = MyCombo.Text & Chr(intKey)
    Else
        ' 2006-11-07, JFW, Correcting combo text should reselect without the trailing text
        'strTemp = Left(MyCombo.Text, MyCombo.SelStart) & Chr(intKey)
        strTemp = Left(MyCombo.Text, MyCombo.SelStart) & Chr(intKey) & Mid(MyCombo.Text, MyCombo.SelStart + 1, Len(MyCombo.Text))
       End If
    
    'Search the entire combo for string
    intIndex = SendMessage(MyCombo.hwnd, CB_FINDSTRING, -1, strTemp)
    
    'If not found intIndex = -1
    If intIndex <> -1 Then
        MyCombo.Text = MyCombo.List(intIndex)
        MyCombo.SelStart = Len(strTemp)
        MyCombo.SelLength = Len(MyCombo.List(intIndex)) - Len(strTemp)
        intKey = 0
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Function
'---------------------------------------------------------------------------------------
' Module    : SetComboSelection
' DateTime  : 8/9/2004
' Author    : Chris Elwell
' Purpose   : Use when assigning values to combo boxes. Pass a combo box and value and
'             it checks the value passed against the list, if found it show the entire
'             text. Used with Service type, Pkg type, payment type, etc.
'---------------------------------------------------------------------------------------
'
Public Function SetComboSelection(ByRef MyCombo As ComboBox, ByVal strVal As String)
    
    On Error GoTo EH
    'g_strErrorLocation = "modMain:SetComboSelection"
    
    Dim i As Integer
    
    For i = 0 To MyCombo.ListCount - 1
        If UCase(Left(MyCombo.List(i), Len(strVal))) = UCase(strVal) Then
            MyCombo.ListIndex = i
            Exit For
        End If
    Next

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:SetComboSelection"
    
    
End Function
'---------------------------------------------------------------------------------------
' Module    : Pause
' DateTime  : 8/23/2004
' Author    : Chris Elwell
' Purpose   : Routine to use if you need to pause in a routine. Pass # of seconds to pause.
'---------------------------------------------------------------------------------------
'
Public Sub Pause(ByVal PauseTime As Integer)
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:Pause"
    
    Dim StartTime As Single
    
    StartTime = Timer
    
    Do Until Timer > StartTime + PauseTime
    Loop

    Exit Sub
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Sub
'---------------------------------------------------------------------------------------
' Module    : GetUserID
' DateTime  : 8/30/2004
' Author    : Chris Elwell
' Purpose   : Returns the Windows Logon ID. Requires API function declaration.
'---------------------------------------------------------------------------------------
'
Public Function GetUserID() As String
    
    On Error GoTo EH
    g_strErrorLocation = "modMain:GetUserID"
    
    Dim strUserID As String
    Dim lngUIDLen As Long
    Dim n As Long
    
    strUserID = Space(255)
    lngUIDLen = 255
    n = GetUserName(strUserID, lngUIDLen)

    If n <> 0 Then
        GetUserID = Left(strUserID, lngUIDLen - 1)
    Else
        GetUserID = ""
    End If

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, g_strErrorLocation
    
End Function
'---------------------------------------------------------------------------------------
' Module    : GetSystemName
' DateTime  : 2/24/2005
' Author    : Chris Elwell
' Purpose   : Returns the Computer name. Requires API function declaration.
'---------------------------------------------------------------------------------------
'
Public Function GetSystemName() As String
    
    On Error GoTo EH
    'g_strErrorLocation = "modMain:GetSystemName"
    
    Dim strName As String
    Dim lngNameSize As Long
    Dim lng As Long
    
    strName = Space(16)
    lngNameSize = Len(strName)
    lng = GetComputerName(strName, lngNameSize)
    
    strName = Replace(strName, Chr(0), "")
    GetSystemName = Trim(strName)

    Exit Function
EH:
    MsgBox Err.Description, vbCritical, "modMain:GetSystemName"
   
End Function

'---------------------------------------------------------------------------------------
' Module    : ResizeAll
' DateTime  : 1/27/2005
' Author    : Chris Elwell
' Purpose   : Resizes controls on a form to ratio of old form size to new form size.
' Called    : Called from Form_Load in frmShip if screen resolution is 800X600.
'---------------------------------------------------------------------------------------
'
Public Function ResizeAll(FormName As Form)
    Dim tmpControl As Control
    Dim lngPrevWidth As Long
    Dim lngPrevHeight As Long
    
    On Error Resume Next
    
    lngPrevWidth = 800
    lngPrevHeight = 600
    
    For Each tmpControl In FormName
        If TypeOf tmpControl Is Line Then
            tmpControl.X1 = tmpControl.X1 / lngPrevWidth * FormName.ScaleWidth
            tmpControl.X2 = tmpControl.X2 / lngPrevWidth * FormName.ScaleWidth
            tmpControl.Y1 = tmpControl.Y1 / lngPrevHeight * FormName.ScaleHeight
            tmpControl.Y2 = tmpControl.Y2 / lngPrevHeight * FormName.ScaleHeight
        Else
            If Left(tmpControl.name, 10) = "fraScreens" Then
                tmpControl.Left = 15
                tmpControl.Top = 315
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            ElseIf tmpControl.name = "WebBrowser1" Then
                tmpControl.Left = 120
                tmpControl.Top = 360
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            Else
                tmpControl.Left = tmpControl.Left / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Top = tmpControl.Top / lngPrevHeight * FormName.ScaleHeight
                tmpControl.Width = tmpControl.Width / lngPrevWidth * FormName.ScaleWidth
                tmpControl.Height = tmpControl.Height / lngPrevHeight * FormName.ScaleHeight
            End If
        End If
    Next tmpControl

End Function

